COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (fasload util fas dsk (aid rpg)))
C00014 ENDMK
C⊗;
(declare (fasload util fas dsk (aid rpg)))
(declare (special *version *dest *source *file *ext *dir
		  *switches *q) (*lexpr %match))

(macrodef flush-last (ll)
	  (let l ← ll
	       then
	       aa bb ← l (cddr l)
	       do
	       (while bb do
		      (setq aa (cdr aa)
			    bb (cdr bb)))
	       (rplacd aa ())
	       l))

(defun transduce-read (message def-ext)
       (terpri)(and message (princ message) (tyo 32.))
       (let syn1 ← (status syntax 44.)
	    syn2 ← (status syntax 46.)
	    syn3 ← (status syntax 60.)
	    syn4 ← (status syntax 61.)
	    syn5 ← (status syntax 40.)
	    syn6 ← (status syntax 41.)
	    syn7 ← (status syntax 58.)
	    mac1 ← (status macro 44.)
	    mac2 ← (status macro 46.)
	    mac3 ← (status macro 60.)
	    mac4 ← (status macro 61.)
	    mac5 ← (status macro 58.)
	    do
	    (setsyntax 44. 2 44.)
	    (setsyntax 46. 2 46.)
	    (setsyntax 91. 2 60.)
	    (setsyntax 93. 2. 61.)
	    (setsyntax 40. 2. 40.)
	    (setsyntax 41. 2. 41.)
	    (setsyntax 58. 2. 58.)
	    (let x ← (unwind-protect 
		      (read)
		      (setsyntax 44. syn1 44.)
		      (setsyntax 46. syn2 46.)
		      (setsyntax 60. syn3 60.)
		      (setsyntax 61. syn4 61.)
		      (setsyntax 40. syn5 40.)
		      (setsyntax 41. syn6 41.)
		      (setsyntax 58. syn7 58.)
		      (and mac1 (sstatus macro 44. (car mac1)))
		      (and mac2 (sstatus macro 46. (car mac2)))
		      (and mac3 (sstatus macro 60. (car mac3)))
		      (and mac4 (sstatus macro 61. (car mac4)))
		      (and mac4 (sstatus macro 58. (car mac5))))
		 *file *ext *dir *version *switches ← nil nil nil nil nil
		 do
		 (cond ((eq x 'quit) (↑g))
		       (t
			(let source dest ← () ()
			     *source *dest ← () ()
			     *switches ← ()
			     input ← (for i ε 
					  (explode x) select 
					  (not (memq i '(/| //))))
			     do
			     (cond ((not (%match '(*dest /← *source) input))
				    (setq *source input))) 
			     (or (%match '(*source /( *switches /)) *source)
				 (%match '(*source /( *switches) *source))
			     (setq source
				   (cond ((or
					   (%match
					    '(/< *dir /> *file /. *ext)
					    *source)
					   (%match
					    '(*dir /: *file /. *ext)
					    *source))
					  (%match '(*ext /. *version) *ext)
					  `((dsk ,(implode *dir))
					    ,(implode *file),(implode *ext)
					    ,(cond (*version (implode *version))
					      (t '/0))))
				    ((or 
				      (%match '(/< *dir /> *file)
					      *source)
				      (%match '(*dir /: *file)
					      *source))
				     `((dsk ,(implode *dir))
				       ,(implode *file)
				       || ))
				    ((%match '(*file /. *ext) *source)
				     (%match '(*ext /. *version) *ext)
				     `((dsk ,(status udir))
				       ,(implode *file),(implode *ext)
				       ,(cond (*version
					       (implode *version))
					      (t '/0))))
				    ((%match '(*file /. *ext) *source)
				     `((dsk ,(status udir))
				       ,(implode *file),(implode *ext)))
				    ((%match '(*file) *source)
				     `((dsk ,(status udir))
				       ,(implode *file) ||))
				    (t 
				     (transduce-read
				      '|Guess again!!!| def-ext))))  
			
			(cond (*dest
				    (setq dest
					  (cond ((or
						  (%match 
						   '(/< *dir />
							*file /. *ext)
							 *dest)
						  (%match
						   '(*dir /: *file /. *ext)
						   *dest))
						 (%match '(*ext /. *version)
							 *ext)
						 `((dsk ,(implode *dir))
						   ,(implode *file)
						   ,(implode *ext)
						   ,(cond (*version (implode *version))
							  (t '/0))))
						((%match 
						  '(*file /. *ext) *dest)
						 (%match '(*ext /. *version)
							 *ext)
						 `(,(car source)
						   ,(implode *file)
						   ,(implode *ext)
						   ,(cond (*version (implode *version))
							  (t '/0))))
						((%match '(*file) *dest)
						 `(,(car source)
						   ,(implode *file) ,def-ext
						   ,(cond (*version (implode *version))
							  (t '/0))))
						(t 
						 (transduce-read
						  '|Guess again!!!| def-ext))))  )
				   (t (setq dest (subst () () source))
				      (and (cddr dest) (rplaca (cddr dest) def-ext))))
			     (list dest source *switches)))))))   
		       
(defun read-filename (message)
       (terpri)
       (and message (princ message)(tyo 32.))
       (let syn1 ← (status syntax 44.)
	    syn2 ← (status syntax 46.)
	    syn3 ← (status syntax 60.)
	    syn4 ← (status syntax 61.)
	    syn5 ← (status syntax 40.)
	    syn6 ← (status syntax 41.)
	    syn7 ← (status syntax 58.)
	    mac1 ← (status macro 44.)
	    mac2 ← (status macro 46.)
	    mac3 ← (status macro 60.)
	    mac4 ← (status macro 61.)
	    mac5 ← (status macro 58.)
	    do
	    (setsyntax 44. 2 44.)
	    (setsyntax 46. 2 46.)
	    (setsyntax 91. 2 60.)
	    (setsyntax 93. 2. 61.)
	    (setsyntax 40. 2. 40.)
	    (setsyntax 41. 2. 41.)
	    (setsyntax 58. 2. 58.)
	    (let x ← (unwind-protect 
		      (read)
		      (setsyntax 44. syn1 44.)
		      (setsyntax 46. syn2 46.)
		      (setsyntax 60. syn3 60.)
		      (setsyntax 61. syn4 61.)
		      (setsyntax 40. syn5 40.)
		      (setsyntax 41. syn6 41.)
		      (setsyntax 58. syn7 58.)
		      (and mac1 (sstatus macro 44. (car mac1)))
		      (and mac2 (sstatus macro 46. (car mac2)))
		      (and mac3 (sstatus macro 60. (car mac3)))
		      (and mac4 (sstatus macro 61. (car mac4)))
		      (and mac4 (sstatus macro 58. (car mac5))))
		 *file *ext *dir *version *switches ← nil nil nil nil nil
		 do
		 (cond ((eq x 'quit) (↑g))
		       (t
			(let 
			     filespec ← nil
			     *switches ← ()
			     input ← (for i ε 
					  (explode x) select 
					  (not (memq i '(/| //))))
			     do
			     (or (%match '(*file /( *switches /)) input)
				 (%match '(*file /( *switches) input))
			     (setq filespec
				   (cond ((or
					   (%match
					    '(/< *dir /> *file /. *ext)
					    *file)
					   (%match
					    '(*dir /: *file /. *ext)
					    *file))
					  (%match '(*ext /. *version) *ext)
					  `((dsk ,(implode *dir))
					    ,(implode *file),(implode *ext)
					    ,(cond (*version (implode *version))
						   (t '/0))))
					 ((or 
					   (%match '(/< *dir /> *file)
						   *file)
					   (%match '(*dir /: *file)
						   *file))
					  `((dsk ,(implode *dir))
					    ,(implode *file)
					    || ))
					 ((%match '(*file /. *ext) *file)
					  (%match '(*ext /. *version) *ext)
					  `((dsk ,(status udir))
					    ,(implode *file),(implode *ext)
					    ,(cond (*version
						    (implode *version))
						   (t '/0))))
					 ((%match '(*file /. *ext) *file)
					  `((dsk ,(status udir))
					    ,(implode *file),(implode *ext)))
					 ((%match '(*file) *file)
					  `((dsk ,(status udir))
					    ,(implode *file) ||))
					 (t 
					  (read-filename
					   '|Guess again!!!|))))  
			       `(,filespec ,*switches))))))))